home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu453.dms / pu453.adf / extras / basic_sources / hillgen2.bas < prev    next >
BASIC Source File  |  1992-11-08  |  3KB  |  152 lines
  1. REM ------- HillGen 2.21
  2. SCREEN 1,320,256,4,1
  3. WINDOW 1,"",(0,0)-(310,240),0,1
  4. RANDOMIZE TIMER
  5. FOR x = 0 TO 15
  6.     PALETTE x,x/15,x/15,x/15
  7. NEXT x
  8. COLOR 15
  9. REM $Option K200
  10.  
  11. DIM d(100,100)
  12.  
  13. maxh = 0.0001
  14. FOR xcc = 1 TO 40
  15.     LOCATE 1,1:COLOR 15:PRINT "Gen Hill :";xcc
  16.     hei = INT(RND*30)+10
  17.     wid = INT(RND*40)+25
  18.     sx  = INT(RND*100)
  19.     sy  = INT(RND*100)
  20.     FOR x = 1 TO wid
  21.         y = 1
  22.         px = (sx+x) MOD 100
  23.         py = (sy+y) MOD 100 
  24.         PSET (px+101,py+31),6
  25.         y = wid        
  26.         px = (sx+x) MOD 100
  27.         py = (sy+y) MOD 100 
  28.         PSET (px+101,py+31),6
  29.     NEXT x
  30.     FOR y = 1 TO wid
  31.         x = 1
  32.         px = (sx+x) MOD 100
  33.         py = (sy+y) MOD 100 
  34.         PSET (px+101,py+31),6
  35.         x = wid        
  36.         px = (sx+x) MOD 100
  37.         py = (sy+y) MOD 100 
  38.         PSET (px+101,py+31),6
  39.     NEXT y    
  40.     FOR x = 0 TO wid
  41.         LOCATE 2,1:PRINT INT(x/wid*100);"%";"      "
  42.         FOR y = 0 TO wid
  43.             IF INKEY$ = "q" THEN y = wid : x = wid
  44.             v = (SIN((x*6.282/wid)-1.570)+1)*(SIN((y*6.282/wid)-1.570)+1)
  45.             v = v / 4
  46.             v = v ^ 1/2
  47.             v = v * hei
  48.             px = (sx+x) MOD 100
  49.             py = (sy+y) MOD 100 
  50.             INCR px : INCR py
  51.             d(px,py) = d(px,py) + v
  52.             IF d(px,py) > maxh THEN maxh = d(px,py)
  53.             PSET (px+100,py+30),d(px,py)/3
  54.         NEXT y
  55.     NEXT x
  56. NEXT xcc
  57. CLS
  58.     
  59. LOCATE 1,1:PRINT "Normalising"
  60. FOR x = 1 TO 100
  61.     LOCATE 2,1:PRINT INT(x);"%";"      "    
  62.     FOR y = 1 TO 100
  63.         d(x,y) = d(x,y) * 15/maxh
  64.         PSET (x+100,y+30),d(x,y)
  65.     NEXT y
  66. NEXT x
  67. CLS
  68.  
  69. xas = 100
  70. FOR y = 2 TO 100
  71.     COLOR 10
  72.     LOCATE 1,25 : PRINT "Plotting : ";y;"%"
  73.     FOR x = 2 TO 100 STEP 3
  74.         IF INKEY$ = "Q" THEN y = 100
  75.         sf = (y+100)/100
  76.         xs = x - 50
  77.         xs = xs * sf
  78.         xs = xs + 150
  79.         ys = y + 50
  80.         dx = d(x,y) - d(x-1,y)
  81.         dy = d(x,y) - d(x,y-1)
  82.         dc = dx - dy
  83.         dc = dc * 6
  84.         dc = dc + 7
  85.         IF dc < 0 THEN dc = 0
  86.         IF dc > 15 THEN dc = 15
  87.         LINE (xs,ys)-(xs+sf,ys-(d(x,y)*3)),dc,bf
  88.         IF (xs+(99*sf)) < 320 THEN LINE (xs+(99*sf),ys)-(xs+(99*sf)+sf,ys-(d(x,y)*3)),dc,bf
  89.         IF (xs-(99*sf)) >   0 THEN LINE (xs-(99*sf),ys)-(xs-(99*sf)+sf,ys-(d(x,y)*3)),dc,bf
  90.     NEXT x
  91.     FOR x = 3 TO 100 STEP 3
  92.         IF INKEY$ = "Q" THEN y = 100
  93.         sf = (y+100)/100
  94.         xs = x - 50
  95.         xs = xs * sf
  96.         xs = xs + 150
  97.         ys = y + 50
  98.         dx = d(x,y) - d(x-1,y)
  99.         dy = d(x,y) - d(x,y-1)
  100.         dc = dx - dy
  101.         dc = dc * 6
  102.         dc = dc + 7
  103.         IF dc < 0 THEN dc = 0
  104.         IF dc > 15 THEN dc = 15
  105.         LINE (xs,ys)-(xs+sf,ys-(d(x,y)*3)),dc,bf
  106.         IF (xs+(99*sf)) < 320 THEN LINE (xs+(99*sf),ys)-(xs+(99*sf)+sf,ys-(d(x,y)*3)),dc,bf
  107.         IF (xs-(99*sf)) >   0 THEN LINE (xs-(99*sf),ys)-(xs-(99*sf)+sf,ys-(d(x,y)*3)),dc,bf
  108.     NEXT x
  109.     FOR x = 4 TO 100 STEP 3
  110.         IF INKEY$ = "Q" THEN y = 100
  111.         sf = (y+100)/100
  112.         xs = x - 50
  113.         xs = xs * sf
  114.         xs = xs + 150
  115.         ys = y + 50
  116.         dx = d(x,y) - d(x-1,y)
  117.         dy = d(x,y) - d(x,y-1)
  118.         dc = dx - dy
  119.         dc = dc * 6
  120.         dc = dc + 7
  121.         IF dc < 0 THEN dc = 0
  122.         IF dc > 15 THEN dc = 15
  123.         LINE (xs,ys)-(xs+sf,ys-(d(x,y)*3)),dc,bf
  124.         IF (xs+(99*sf)) < 320 THEN LINE (xs+(99*sf),ys)-(xs+(99*sf)+sf,ys-(d(x,y)*3)),dc,bf
  125.         IF (xs-(99*sf)) >   0 THEN LINE (xs-(99*sf),ys)-(xs-(99*sf)+sf,ys-(d(x,y)*3)),dc,bf
  126.     NEXT x
  127. NEXT y
  128.     DECR y
  129.     LOCATE 1,25 : PRINT "                         "
  130.     FOR x = 2 TO 100
  131.         IF INKEY$ = "Q" THEN y = 100
  132.         sf = (y+100)/100
  133.         xs = x - 50
  134.         xs = xs * sf
  135.         xs = xs + 150
  136.         ys = y + 50
  137.         dx = d(x,y) - d(x-1,y)
  138.         dy = d(x,y) - d(x,y-1)
  139.         dc = dx - dy
  140.         dc = dc * 6
  141.         dc = dc + 7
  142.         IF dc < 0 THEN dc = 0
  143.         IF dc > 15 THEN dc = 15
  144.         LINE (xs,ys)-(xs+sf,ys-(d(x,y)*3)),5,bf
  145.         LINE (xs+(99*sf),ys)-(xs+(99*sf)+sf,ys-(d(x,y)*3)),5,bf
  146.         LINE (xs-(99*sf),ys)-(xs-(99*sf)+sf,ys-(d(x,y)*3)),5,bf
  147.     NEXT x
  148.  
  149.  
  150. LOCATE 28,1 : INPUT a$
  151. SYSTEM        
  152.